home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / pcl_src.zoo / vaxl-low.lsp < prev    next >
Lisp/Scheme  |  1992-07-09  |  3KB  |  81 lines
  1. ;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Use and copying of this software and preparation of derivative works
  8. ;;; based upon this software are permitted.  Any distribution of this
  9. ;;; software or derivative works must comply with all applicable United
  10. ;;; States export control laws.
  11. ;;; 
  12. ;;; This software is made available AS IS, and Xerox Corporation makes no
  13. ;;; warranty about the software, its performance or its conformity to any
  14. ;;; specification.
  15. ;;; 
  16. ;;; Any person obtaining a copy of this software is requested to send their
  17. ;;; name and post office or electronic mail address to:
  18. ;;;   CommonLoops Coordinator
  19. ;;;   Xerox PARC
  20. ;;;   3333 Coyote Hill Rd.
  21. ;;;   Palo Alto, CA 94304
  22. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  23. ;;;
  24. ;;; Suggestions, comments and requests for improvements are also welcome.
  25. ;;; *************************************************************************
  26. ;;;
  27. ;;; The version of low for VAXLisp
  28. ;;; 
  29. (in-package 'pcl)
  30.  
  31. (defmacro without-interrupts (&body body)
  32.   `(macrolet ((interrupts-on  ()
  33.            `(when (null outer-scheduling-state)
  34.           (setq system::*critical-section-p* nil)
  35.           (when (system::%sp-interrupt-queued-p)
  36.             (system::interrupt-dequeuer t))))
  37.           (interrupts-off ()
  38.            `(setq system::*critical-section-p* t)))
  39.      (let ((outer-scheduling-state system::*critical-section-p*))
  40.        (prog1 (let ((system::*critical-section-p* t)) ,@body)
  41.           (when (and (null outer-scheduling-state)
  42.              (system::%sp-interrupt-queued-p))
  43.         (system::interrupt-dequeuer t))))))
  44.  
  45.  
  46.   ;;   
  47. ;;;;;; Load Time Eval
  48.   ;;
  49. (defmacro load-time-eval (form)
  50.   `(progn ,form))
  51.  
  52.   ;;   
  53. ;;;;;; Generating CACHE numbers
  54.   ;;
  55. ;;; How are symbols in VAXLisp actually arranged in memory?
  56. ;;; Should we be shifting the address?
  57. ;;; Are they relocated?
  58. ;;; etc.
  59.  
  60. ;(defmacro symbol-cache-no (symbol mask)
  61. ;  `(logand (the fixnum (system::%sp-pointer->fixnum ,symbol)) ,mask))
  62.  
  63. (defmacro object-cache-no (object mask)
  64.   `(logand (the fixnum (system::%sp-pointer->fixnum ,object)) ,mask))
  65.  
  66.   ;;   
  67. ;;;;;; printing-random-thing-internal
  68.   ;;
  69. (defun printing-random-thing-internal (thing stream)
  70.   (format stream "~O" (system::%sp-pointer->fixnum thing)))
  71.  
  72.  
  73. (defun function-arglist (fn)
  74.   (system::function-lambda-vars (symbol-function fn)))
  75.  
  76. (defun set-function-name-1 (fn name ignore)
  77.   (cond ((system::slisp-compiled-function-p fn)
  78.      (system::%sp-b-store fn 3 name)))
  79.   fn)
  80.  
  81.